home *** CD-ROM | disk | FTP | other *** search
/ Aminet 40 / Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso / Aminet / misc / emu / ATUtilities.lha / ATUtilities / gdos.mod < prev    next >
Text File  |  2000-09-26  |  6KB  |  379 lines
  1. (*$ S- *)
  2. MODULE GDOS;
  3.  
  4. FROM SYSTEM  IMPORT ASSEMBLER,BYTE,WORD,ADDRESS,ADR,OFS,SEG,SEGMENT,OFFSET;
  5. FROM Storage IMPORT ALLOCATE,DEALLOCATE;
  6. FROM System  IMPORT AX,BX,CX,DX,ES,DS,SI,DI,Trap,XTrap,Move,SetVector,GetVector,
  7.                     TermProcedure,Terminate,InstallRTErrorHandler,
  8.                     UninstallRTErrorHandler;
  9. FROM InOut   IMPORT WriteString,WriteCard,WriteLn;
  10. FROM Strings IMPORT Length;
  11.  
  12. CONST
  13.  gadgetBoolean = 1;
  14.  gadgetToggle  = 2;
  15.  gadgetString  = 3;
  16.  gadgetClose   = 4;
  17.  gadgetMenu    = 20;
  18.  
  19. TYPE
  20.  GDOS = RECORD
  21.   oldColors  : ARRAY [0..(16*3)] OF BYTE;
  22.   mouseLock  : CARDINAL;
  23.   graphics64 : ADDRESS;
  24.  END (* RECORD *);
  25.  
  26.  Menu = RECORD
  27.   leftEdge,width : CARDINAL;
  28.   text           : ARRAY [0..19] OF CHAR;
  29.   enabled        : BOOLEAN;
  30.  END (* RECORD *);
  31.  
  32.  MenuItem = RECORD
  33.   text       : ARRAY [0..29] OF CHAR;
  34.   checkit    : BOOLEAN;
  35.   checked    : BOOLEAN;
  36.   enabled    : BOOLEAN;
  37.  END (* RECORD *);
  38.  
  39.  Gadget = RECORD
  40.   leftEdge,topEdge,
  41.   width,height       : CARDINAL;
  42.   type               : CARDINAL;
  43.   text               : ADDRESS;
  44.   undo               : ADDRESS;
  45.   borderless         : BOOLEAN;
  46.   menu               : POINTER TO Menu;
  47.  END (* RECORD *);
  48.  
  49. VAR gdos : GDOS;
  50.     a,b  : INTEGER;
  51.     gfx  : ADDRESS;
  52.  
  53.  
  54. PROCEDURE Abbruch(text : ARRAY OF CHAR);
  55. BEGIN
  56.  WriteString("NICHT BEHEBBARER FEHLER BEI DER PROGRAMMAUSFÜHRUNG:");
  57.  WriteLn;
  58.  WriteString(text);
  59.  WriteLn;
  60.  WriteLn;
  61.  HALT;
  62. END Abbruch;
  63.  
  64. PROCEDURE CheckVGA;
  65. BEGIN
  66.  AX := 01A00H;
  67.  Trap(010H);
  68.  
  69.  IF ((AX MOD 256)=01AH) THEN
  70.   WriteString("VGA Okay");
  71.   WriteLn;
  72.  ELSE
  73.   Abbruch("Dieses Programm benötigt eine VGA-Karte!");
  74.  END (* IF *);
  75. END CheckVGA;
  76.  
  77. PROCEDURE CheckMouse;
  78. VAR maus : ADDRESS;
  79. BEGIN
  80.  GetVector(033H,maus);
  81.  IF (maus=NIL) THEN
  82.   Abbruch("Dieses Programm benötigt einen Maustreiber an Interrupt $33!");
  83.  END (* IF *);
  84.  AX := 0;
  85.  Trap(033H);
  86.  IF (AX=0) THEN
  87.   Abbruch("Fehler beim installieren der Maus!");
  88.  END (* IF *);
  89. END CheckMouse;
  90.  
  91. PROCEDURE MouseOn;
  92. BEGIN
  93.  IF (gdos.mouseLock=0) THEN
  94.   AX := 1;
  95.   Trap(033H);
  96.  END (* IF *);
  97. END MouseOn;
  98.  
  99. PROCEDURE MouseOff;
  100. BEGIN
  101.  IF (gdos.mouseLock=0) THEN
  102.   AX := 2;
  103.   Trap(033H);
  104.  END (* IF *);
  105. END MouseOff;
  106.  
  107. PROCEDURE MouseLock;
  108. BEGIN
  109.  INC(gdos.mouseLock);
  110. END MouseLock;
  111.  
  112. PROCEDURE MouseUnlock;
  113. BEGIN
  114.  DEC(gdos.mouseLock);
  115. END MouseUnlock;
  116.  
  117. PROCEDURE WaitForKey;
  118. BEGIN
  119.  AX := 0;
  120.  Trap(016H);
  121. END WaitForKey;
  122.  
  123. PROCEDURE SetRGB(c,r,g,b : CARDINAL);
  124. BEGIN
  125.  AX := 01010H;
  126.  BX := c;
  127.  CX := g*256+b;
  128.  DX := r*256;
  129.  Trap(010H);
  130. END SetRGB;
  131.  
  132. PROCEDURE PutChar(farbe,x,y : CARDINAL; zeichen : CHAR);
  133. BEGIN
  134.  ASM
  135.   MOV AH,2
  136.   MOV BX,x
  137.   MOV DL,BL
  138.   MOV BX,y
  139.   MOV DH,BL
  140.   MOV BX,0
  141.   INT 10H
  142.   MOV AH,9
  143.   MOV CX,1
  144.   MOV AL,zeichen
  145.   MOV DX,farbe
  146.   MOV BL,DL
  147.   MOV BH,0
  148.   INT 10H
  149.  END (* ASM *);
  150. END PutChar;
  151.  
  152. PROCEDURE Text(farbe,x,y : CARDINAL; text : ARRAY OF CHAR);
  153. VAR i : CARDINAL;
  154. BEGIN
  155.  MouseOff;
  156.  
  157.  FOR i := 0 TO Length(text)-1 DO
  158.   PutChar(farbe,x+i,y,text[i]);
  159.  END (* FOR *);
  160.  
  161.  MouseOn;
  162. END Text;
  163.  
  164. PROCEDURE WritePixel(farbe,x,y : CARDINAL);
  165. BEGIN
  166.  ASM
  167.   MOV DX,farbe
  168.   MOV AL,DL
  169.   MOV AH,0CH
  170.   MOV BH,0
  171.   MOV DX,y
  172.   MOV CX,x
  173.   INT 10H
  174.  END (* ASM *);
  175. END WritePixel;
  176.  
  177. PROCEDURE DrawX(farbe,x,y,xw : CARDINAL);
  178. VAR z : CARDINAL;
  179. BEGIN
  180.  FOR z := x TO xw DO
  181.   WritePixel(farbe,z,y);
  182.  END (* FOR *);
  183. END DrawX;
  184.  
  185. PROCEDURE DrawY(farbe,x,y,yw : CARDINAL);
  186. VAR z : CARDINAL;
  187. BEGIN
  188.  FOR z := y TO yw DO
  189.   WritePixel(farbe,x,z);
  190.  END (* FOR *);
  191. END DrawY;
  192.  
  193. PROCEDURE DrawBorder(fp,bp,x,y,w,h : CARDINAL);
  194. VAR i : CARDINAL;
  195. BEGIN
  196.  MouseOff;
  197.  DrawX(fp,x,y,x+w);
  198.  DrawY(fp,x,y,y+h);
  199.  DrawX(bp,x+1,y+h,x+w-1);
  200.  DrawY(bp,x+w,y+1,y+h-1);
  201.  MouseOn;
  202. END DrawBorder;
  203.  
  204. PROCEDURE OpenScreen(mode : INTEGER);
  205. BEGIN
  206.  AX := 01017H;
  207.  BX := 0;
  208.  CX := 16;
  209.  ES := SEGMENT(gdos.oldColors);
  210.  DX := OFFSET(gdos.oldColors);
  211.  XTrap(010H);
  212.  AX := mode;
  213.  Trap(010H);
  214.  SetRGB(0,180,180,180);
  215.  SetRGB(1,255,255,255);
  216.  SetRGB(2,0,0,0);
  217.  SetRGB(3,255,255,85);
  218.  gdos.mouseLock  := 0;
  219.  ALLOCATE(gdos.graphics64,0FFFFH);
  220.  IF (gdos.graphics64 = NIL) THEN
  221.   CloseScreen;
  222.   Abbruch("Es stehen keine 64 KBytes Speicher mehr zur Verfügung!");
  223.  END (* IF *);
  224.  MouseOn;
  225. END OpenScreen;
  226.  
  227. PROCEDURE CloseScreen;
  228. BEGIN
  229.  MouseOff;
  230.  AX := 3;
  231.  Trap(010H);
  232.  IF (gdos.graphics64 # NIL) THEN
  233.   DEALLOCATE(gdos.graphics64,0FFFFH);
  234.  END (* IF *);
  235.  AX := 01012H;
  236.  BX := 0;
  237.  CX := 16;
  238.  ES := SEGMENT(gdos.oldColors);
  239.  DX := OFFSET(gdos.oldColors);
  240.  XTrap(010H);
  241.  AX := 0;
  242.  Trap(033H);
  243. END CloseScreen;
  244.  
  245. (* ----------- Hauptprogramm ------------------ *)
  246.  
  247. PROCEDURE RTErrorHandler(fehler : CARDINAL; adresse : ADDRESS);
  248. BEGIN
  249.  CloseScreen;
  250.  WriteString("NICHT BEHEBBARER FEHLER BEI DER PROGRAMMAUSFÜHRUNG!");
  251.  WriteLn;
  252.  WriteString("Abbruch durch Modula-2 RunTime-Fehler #");
  253.  WriteCard(fehler,1);
  254.  WriteLn;
  255.  WriteLn;
  256. END RTErrorHandler;
  257.  
  258. PROCEDURE Terminator;
  259. BEGIN
  260.  WriteString("bye!");
  261.  WriteLn;
  262. END Terminator;
  263.  
  264. PROCEDURE Video2Video;
  265. BEGIN
  266.  ASM
  267.   MOV AX,0A000H
  268.   MOV ES,AX
  269.   MOV DS,AX
  270.   MOV SI,0
  271.   MOV DI,19200
  272.   MOV CX,12800
  273.   CLD
  274.  
  275.   MOV DX,03CEH
  276.   MOV AX,0105H
  277.   OUT DX,AX
  278.  
  279.   REP MOVSB
  280.  END;
  281. END Video2Video;
  282.  
  283. PROCEDURE Test(t : CHAR; u : CARDINAL);
  284. VAR arr : BYTE;
  285.     seg : CARDINAL;
  286.     ofs : CARDINAL;
  287. BEGIN
  288.  seg := gdos.graphics64.SEG;
  289.  ofs := gdos.graphics64.OFS;
  290.  ASM
  291.   MOV AX,0A000H
  292.   MOV BX,seg
  293.   MOV DS,AX
  294.   MOV SI,0
  295.   MOV ES,BX
  296.   MOV DI,ofs
  297.  
  298.   MOV CX,19200
  299.  
  300.  
  301.   MOV DX,03CEH
  302.   MOV AX,0005H
  303.   OUT DX,AX
  304.  
  305.   MOV DX,03CEH
  306.   MOV AH,t
  307.   MOV AL,04H
  308.   OUT DX,AX
  309.  
  310.  MOV DX,03C4H
  311.  MOV AL,02H
  312.  MOV BX,u
  313.  MOV AH,BL
  314.  OUT DX,AX
  315.  
  316. x:
  317.   MOV BL,DS:[SI]
  318.   MOV ES:[DI],BL
  319.  
  320.   MOV BL,DS:[0]
  321.   MOV BL,DS:[100]
  322.   MOV BL,DS:[200]
  323.   MOV BL,DS:[321]
  324.  
  325.   MOV BL,ES:[DI]
  326.   MOV DS:[SI+19200],BL
  327.  
  328.   ADD SI,1
  329.   ADD DI,1
  330.   SUB CX,1
  331.   CMP CX,0
  332.   JNE x
  333.  
  334.   MOV DX,03C4H
  335.   MOV AX,0F02H
  336.   OUT DX,AX
  337.  
  338.  END;
  339. END Test;
  340.  
  341.  
  342. BEGIN
  343.  
  344.  CheckVGA();
  345.  CheckMouse();
  346.  OpenScreen(012H);
  347.  TermProcedure(Terminator);
  348.  InstallRTErrorHandler(RTErrorHandler);
  349.  
  350.  (* ------------------------------------------ *)
  351.  
  352. gfx := gdos.graphics64;
  353.  
  354.  DrawBorder(1,2,50,50,500,300);
  355.  
  356.  DrawBorder(1,2,1,10,638,460);
  357.  DrawBorder(2,1,2,11,636,458);
  358.  DrawBorder(1,2,1,11,638,20);
  359.  
  360.  FOR a := 1 TO 15 DO
  361.   Text(a,10,a+5,"Graphical DOS User Interface - Version 0.01");
  362.  END;
  363.  
  364.  Test(0C,1);
  365.  Test(1C,2);
  366.  Test(2C,4);
  367.  Test(3C,8);
  368.  
  369.  
  370.  WaitForKey;
  371.  
  372.  (* ------------------------------------------ *)
  373.  
  374.  CloseScreen;
  375.  UninstallRTErrorHandler;
  376.  Terminate(0);
  377.  
  378. END GDOS.
  379.